perm filename SCENE.SAI[SYS,HE]2 blob
sn#048174 filedate 1973-06-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SCENE - cross-reference mapping schemes
C00005 00003 _ LCOMCV
C00007 00004 _ XREF
C00009 00005 _ XREF cont
C00011 00006 _ XREF cont
C00013 00007 _ XREF cont
C00015 00008 _ XREF cont
C00017 00009 _ XREF cont
C00020 00010 _ XREF cont
C00023 00011 _ XREF cont
C00026 00012 _ XREF cont
C00029 00013 _ XREF cont
C00030 00014 _ UNXREF
C00032 ENDMK
C⊗;
COMMENT SCENE - cross-reference mapping schemes;
ENTRY LCOMCV,XREF,UNXREF;
BEGIN "SCENE"
DEFINE QI="INTEGER",
QR="REAL",
QRI="REFERENCE INTEGER",
QRR="REFERENCE REAL",
QEP="EXTERNAL SIMPLE PROCEDURE",
QEIP="EXTERNAL SIMPLE INTEGER PROCEDURE",
QERP="EXTERNAL SIMPLE REAL PROCEDURE",
QFOP="FORWARD INTERNAL SIMPLE PROCEDURE",
QFOIP="FORWARD INTERNAL SIMPLE INTEGER PROCEDURE",
QFORP="FORWARD INTERNAL SIMPLE REAL PROCEDURE",
_="COMMENT",
LOOP(I,J,K,L)="FOR I←J STEP L UNTIL K DO",
SAFEX="SAFE";
INTEGER IA,IB,IC,ID,IE,LNCS1,LNCS2;
EXTERNAL INTEGER IFREEV,MAXNOL,MAXNOV,LNCRE1,LNCRE2;
EXTERNAL REAL RWIC,RMLE,RCDI,RMALS,RMRLS;
SAFEX EXTERNAL INTEGER ARRAY LVERSI,LVERCO,LVER,IPK,IPS,LINK[1:1];
SAFEX EXTERNAL REAL ARRAY XVCOR,YVCOR,SVANG,XLCOR,YLCOR,RK,RBK,RAS,RBS,
RCOL,RLEN[1:1];
QEIP ISIGN(QI I,J);
QEIP LVNEXT(QI I,J);
QEIP LVOPP(QI I);
QEIP MERCV(QI I,J,K);
QEIP NLINCV(QI I);
QEIP LACT(QI I);
QEIP BELCRE(QI I);
QEIP KARN(QR X1,Y1,X2,Y2,X3,Y3,X4,Y4; QRR X,Y;
QRI IX1,IX2,IP1,IP2; QRR R1,R2; QI IC; QR WI);
QEP PLDIS(QR X,Y; QI I; QRR XL,YL,R; QRI IW);
QERP LDIST(QR X,Y; QI I);
QEIP NEXVER;
QEP RETCV(INTEGER ICV);
_ LCOMCV;
_ Returns number of common line, or 0 if no such line.
Counts all types and connections.;
INTERNAL SIMPLE INTEGER PROCEDURE LCOMCV(INTEGER ICV1,ICV2);
BEGIN "LCOMCV"
LABEL L1;
INTEGER ISV;
ISV←ABS LVNEXT(ICV1,8);
L1: IF ISV=0 THEN RETURN(0);
IF LACT((ISV+1)%2)∧LVERCO[LVOPP(ISV)]=ICV2 THEN RETURN((ISV+1)%2);
_ No, this line is inactive or not common to ICV1 and ICV2, iterate.;
ISV←ABS LVNEXT(0,8);
GO L1;
END "LCOMCV";
_ XREF;
_ Sets up cross-reference tables, based on line intersections,
and uses those tables as a basis for the creation of temporary
compound vertices. Those will later be utilized in the object
abstraction schemes. Collinearities are also recorded as midway-point
intersections. The program only works with active lines.;
INTERNAL SIMPLE PROCEDURE XREF;
BEGIN "XREF"
LABEL L200,PSL,BA0;
INTEGER I1,I2,I3,IV1,IV2,IDUM,IX1,IX2,IP1,IP2,IL,ICV1,ICV2,LCV1,LCV2,
PS,IT,ISV1,ISV2,LB,IS1,IS2;
REAL RMLES,RMALSS,RMRLSS,RCDIS,X,Y,R1,R2,RWICS,RX;
_ First prepare the distance tables.;
LOOP(I1,1,MAXNOV,1) RK[I1]←RAS[I1]←RCOL[I1]←900000.;
LOOP(I1,1,MAXNOL,1) IF LACT(I1) THEN LINK[2*I1-1]←LINK[2*I1]←0;
IT←PS←0;
RX←RMLES←RMLE↑2;
RMALSS←RMALS↑2;
RMRLSS←RMRLS↑2;
RCDIS←RCDI↑2;
RWICS←RWIC↑2;
_ XREF cont;
_ The following is the MAIN X-REF SETUP LOOP....;
_ The loop is used three times.
1: IT=0 PS=0 Regular pass, using RMLE.
2: IT=1 PS=0 Amending blocked intersections, using RMLE.
3: IT=0 PS=6 Final pass extension-intersections, using 2*RMLE for sums.;
BA0: LOOP(I1,1,MAXNOL+IT-1,1)
BEGIN "LP11" LABEL L11;
IF ¬LACT(I1)∨RK[ISV1←2*I1]=-1. THEN GO L11;
IF PS∧ABS LVER[ISV1]≠ISV1∧ABS LVER[ISV1-1]≠ISV1-1
THEN GO L11;
IF IT∧¬((ICV1←(ISV2←ABS IPS[ISV1-1])∧
(RK[ISV2]<RBS[ISV1-1]∨4.0*RCOL[ISV2]<RBS[ISV1-1]))
∨(ICV2←(ISV2←ABS IPS[ISV1])∧
(RK[ISV2]<RBS[ISV1]∨4.0*RCOL[ISV2]<RBS[ISV1])))
THEN GO L11;
IF IT∧ICV1 THEN
BEGIN
RAS[ISV1-1]←900000.;
IPS[ISV1-1]←0
END;
IF IT∧ICV2 THEN
BEGIN
RAS[ISV1]←900000.;
IPS[ISV1]←0
END;
LB←I1*(1-IT)+1;
LOOP(I2,LB,MAXNOL,1)
BEGIN "LP12"
LABEL L12,L120,L13,L130,L21,L22,L42,L420,L41,
L32,L31,L310;
IF I1=I2∨¬LACT(I2)∨RK[ISV2←2*I2]=-1. THEN GO L12;
IF PS∧ABS LVER[ISV2]≠ISV2∧
ABS LVER[ISV2-1]≠ISV2-1 THEN GO L12;
_ XREF cont;
_ Both lines are active.;
_ Find intersection (or collinear equivalent).;
L13: IDUM←KARN(XLCOR[ISV1-1],YLCOR[ISV1-1],
XLCOR[ISV1],YLCOR[ISV1], XLCOR[ISV2-1],
YLCOR[ISV2-1],XLCOR[ISV2],YLCOR[ISV2],
X,Y,IX1,IX2,IP1,IP2,R1,R2,0,RWIC);
IF IDUM<-1 THEN
BEGIN
RK[IV1←IF IDUM=-2 THEN ISV1
ELSE ISV2]←-1.;
RK[IV1-1]←-1.;
GO L12
END;
IF PS∧(IP1≤0∨IP2≤0) THEN GO L12;
IF IT∧(IP1≤0∨IP2≤0∨IP1=1∧¬ICV1∨IP1=2∧¬ICV2)
THEN GO L12;
_ IVN are the closest s.v:s.;
L130: IV1←ISV1+ ABS IP1 -2;
IV2←ISV2+ ABS IP2 -2;
IF PS∧(ABS LVER[IV1]≠IV1∨ABS LVER[IV2]≠IV2)
THEN GO L12;
IF IT+PS∧(R1>RK[IV1]∨R2>RK[IV2]∨R1>4.0*RCOL[IV1]∨
R2>4.0*RCOL[IV2]) THEN GO L12;
_ Record collinearity iff IDUM=-1 and there is no
previous entry or the present distance is smaller.;
IF ¬(IT+PS)∧(IDUM=-1∧R1<RCOL[IV1]∧R1<RCOL[IV2])
THEN BEGIN
LINK[IV1]←IV2;
LINK[IV2]←IV1;
RCOL[IV1]←RCOL[IV2]←R1;
END;
_ Here is where we separate the different cases.;
IF IP1>0 THEN GO L22;
IF IP1=0 THEN GO L12;
_ IP1 ← 0 iff lines do not intersect.;
L21: IF IP2≤0 THEN GO L31 ELSE GO L32;
_ XREF cont;
_ IP2 ≠ 0, always if IP1 ≠ 0.;
L22: IF IP2≤0 THEN GO L41;
_ IP1 > 0 and IP2 > 0.;
L42: IF ¬PS∧(R1>RX∨R2>RX)∨PS∧R1+R2>RX THEN GO L12;
_ Extensions are OK.;
IF R1≥RAS[IV1] THEN GO L420;
_ New minimum for first line, save.
Collinear case remembered as negative sign of IPS.;
RAS[IV1]←R1;
RBS[IV1]←R2;
IPS[IV1]←ISIGN(IV2,IDUM);
L420: IF IT∨R2≥RAS[IV2] THEN GO L12;
_ New minimum for second line, save.
Collinear case remembered as negative sign of IPS.;
RAS[IV2]←R2;
RBS[IV2]←R1;
IPS[IV2]←ISIGN(IV1,IDUM);
GO L12;
_ IP1 > 0 and IP2 < 0.;
L41: IF R1≥RK[IV1] THEN GO L12;
_ New minimum distance to crossing line, for line 1.;
RK[IV1]←R1;
RBK[IV1]←R2;
IPK[IV1]←IV2;
GO L12;
_ IP1 < 0 and IP2 > 0.;
L32: IF R2≥RK[IV2] THEN GO L12;
_ New minimum distance to crossing line, for line 2.;
RK[IV2]←R2;
RBK[IV2]←R1;
IPK[IV2]←IV1;
GO L12;
_ XREF cont;
_ IP1 <0 and IP2 < 0. Lines cross. Shorten one
of them to get the case of a T-joint. Then use
stopping cases above. Note that this case is
only presumed possible just after the initial
line-fit, not later.;
L31: IDUM←(IF R1>R2 THEN IV2 ELSE IV1);
XVCOR[LVERCO[IDUM]]←X;
YVCOR[LVERCO[IDUM]]←Y;
IF R1>R2 THEN GO L310;
R1←0.;
IP1←-IP1;
GO L41;
L310: R2←0.;
IP2←-IP2;
GO L32;
_ CHECK FOR PARALLELITY MAY BE IMPLEMENTED HERE LATER.;
L12: ; _ Inner loop ends...;
L120: END "LP12";
_ Outer loop ends...;
L11: END "LP11";
_ Iterate once, in order to (possibly) replace blocked intersections.;
IF ¬(IT+PS) THEN BEGIN IT←1; GO BA0 END;
_ XREF cont;
_ ***** CROSS-REFERENCE TABLES NOW EXIST *****;
_ Now create temporary vertices and possible T-joints.
The indexing is in the s.v. structure [line-ends].
First pass: Join acceptable extension-intersections, using RMLE/2.
Second pass: Same, except use RMLE.
Third pass: Join ends with small cut stops, iff either end is free,
giving preference to shortest RK of line-pair.
Fourth pass: Same, except no preference.
Fifth pass: Join still free ends into closest vertices,
provided distance and PLDIS are OK.
Sixth pass: Iterate extension intersections once more, using
2*RMLE for sums.;
IF ¬PS THEN BEGIN PS←1; RX←RMLES*0.25; IT←0 END;
PSL: LOOP(I1,1,MAXNOV,1)
BEGIN "LP101" LABEL L101,L1020,L1010;
IF ¬LACT(IL←(I1+1)%2)∨RK[I1]=-1.∨PS≥5∧ABS LVER[I1]≠I1
THEN GO L101;
IF PS=3∨PS=4 THEN GO L1010;
_ Line is active. If first, second or sixth pass, check if
there is an extension-intersection (restore IPS,
if second pass, while taking care to remember it to MERCV).
If fifth pass, check for junctions of free lines to vertices.;
IF PS=5 THEN
BEGIN
R1←900000.;
ICV1←LVERCO[IP2←LVOPP(I1)];
LCV1←LVERCO[I1];
LOOP(I2,1,MAXNOV,1) IF I2≠LCV1∧I2≠ICV1∧BELCRE(I2)
THEN BEGIN
PLDIS(XVCOR[I2],YVCOR[I2],IL,X,Y,R2,IP1);
IF IP1=1∧R2<2.*RWICS
∧(R2←(XLCOR[I1]-X)↑2+
(YLCOR[I1]-Y)↑2)<R1
∧R2<(XLCOR[IP2]-X)↑2+(YLCOR[IP2]-Y)↑2
THEN BEGIN R1←R2; ICV2←I2 END
END;
IF R1<RX∧(R1<RK[I1]∨LVERCO[IPK[I1]]=ICV2) THEN
MERCV(LCV1,ICV2,0);
GO L101
END;
I2←(IPS[I1]<0);
I3←ABS IPS[I1];
IF PS=2 THEN IPS[I1]←I3;
IF RAS[I1]>RX∨RBS[I1]>RX∨RK[I1]<RAS[I1] THEN GO L101;
_ XREF cont;
_ There are no stopping lines in between the two lines, an
intersection is listed, and the second line is eligible.
Therefore sofar OK to join the c.v:s of the two lines in
a temporary compound vertex, i.e. topologically. The
c.v:s created here are highly temporary in nature, and
will be subject to change, as the process reaches higher
stages.;
L1020: ICV1←LVERCO[I1];
ICV2←LVERCO[I3];
IF ¬((IS1←ABS LVER[I1]=I1)
∧(IS2←ABS LVER[I3]=I3))
∧(IS1
∧ABS LDIST(XVCOR[ICV2],YVCOR[ICV2],IL)>RWIC
∨IS2
∧ABS LDIST(XVCOR[ICV1],YVCOR[ICV1],(I3+1)%2)>RWIC
∨¬IS1
∧¬IS2
∧(XVCOR[ICV1]-XVCOR[ICV2])↑2+
(YVCOR[ICV1]-YVCOR[ICV2])↑2>RCDIS) THEN GO L101;
_ The distance between a non-single c.v. and the other c.v.
or line is OK. Therefore join the c.v:s.;
IDUM←MERCV(ICV1,ICV2,I2);
GO L101;
_ Register stopping line as possible T?;
L1010: IF RK[I1]≥900000. THEN GO L101;
_ Yes, there is a stopping line.;
_ FOR NOW WE DO NOT USE IT - KKP;
I2 ← IPK[I1];
_ Register as intersection, i.e. merge, as well?;
IF (I3← ABS LVER[I1]≠I1)
∧ ABS LVER[I2]≠I2
∨ I3∧PS=3
∧RK[I1]≥RK[I2]
∨ RK[I1]>RMLES
∨RBK[I1]>RMALSS
∨RBK[I1]>RMRLSS*RLEN[(I2+1)%2]↑2 THEN GO L101;
_ XREF cont;
_ At least one end is free, the distance is OK,
and the cut is small enough. Merge the c.v:s.;
LCV1←LVERCO[I1];
LCV2←LVERCO[IPK[I1]];
IDUM←MERCV(LCV1,LCV2,0);
_ End of primary c.v.-joining loop...;
L101: END "LP101";
RX←IF PS=1 THEN RMLES ELSE IF PS=4 THEN 2.*RMLES ELSE 4.*RMLES;
IF (PS←PS+1)<6 THEN GO PSL;
IF PS=6 THEN GO BA0;
_ ***** PRIMARY C.V. COUMPOUNDS NOW EXIST *****;
_ OK, by now all the intersection-indicated c.v:s are created.
The next step is to merge neighbouring c.v:s, provided they
are within the maximum distance, CDI, from one another, and
that a line between them would not cross any other line in
the topological picture.;
L200: LOOP(I1,1,MAXNOV-1,1)
BEGIN "LP201" LABEL L201;
_ C.v. is active?;
IF ¬BELCRE(I1) THEN GO L201;
LOOP(I2,I1+1,MAXNOV,1)
BEGIN "LP202" LABEL L202;
_ Second c.v. is active, as well?;
IF ¬BELCRE(I2) THEN GO L202;
_ Yes, it is. Are they close enough?;
IF (XVCOR[I1]-XVCOR[I2])↑2+
(YVCOR[I1]-YVCOR[I2])↑2>RCDIS THEN GO L202;
_ Yes, they are. Do they have a line in common?;
IF LCOMCV(I1,I2)≠0 THEN GO L202;
_ No, they don't. Are they both single?;
IF NLINCV(-I1)*NLINCV(-I2)=1 THEN GO L202;
_ XREF cont;
_ No, they aren't. Does their line-of-sight cross
any line, in the TOPOLOGICAL picture? Check all
active lines!;
LOOP(I3,1,MAXNOV,2)
BEGIN "LP203" LABEL L203;
_ Is the line active?;
IF ¬LACT((I3+1)%2) THEN GO L203;
_ Yes, it is. Find end c.v:s.;
ICV1←LVERCO[I3];
ICV2←LVERCO[I3+1];
_ Does the line belong to our two c.v:s?;
IF (I1-ICV1)*(I1-ICV2)*(I2-ICV1)*
(I2-ICV2)=0 THEN GO L203;
_ No, it doesn't. Check intersection.;
IDUM←KARN(XVCOR[I1],YVCOR[I1],XVCOR[I2]
,YVCOR[I2],XVCOR[ICV1],YVCOR[ICV1]
,XVCOR[ICV2],YVCOR[ICV2],X,Y,IX1
,IX2,IP1,IP2,R1,R2,0,RWIC);
_ If the lines cross, we lose. Try next
second c.v.;
IF IP1<0∧IP2<0 THEN GO L202;
_ The lines do not cross. Check the next one.;
L203: END "LP203";
_ All lines are cleared. Merge I1 and I2.;
IF IDUM←MERCV(I1,I2,0) THEN GO L200;
_ After a merge, unfortunately, it is necessary to
iterate all the way back (now or later), but on
the other hand it won't happen very often!;
_ End of inner final-merge loop...;
L202: END "LP202";
_ End of outer final-merge loop...;
L201: END "LP201";
_ XREF cont;
_ Finally check collinearities. Negate links between all active,
unjoined s.v:s where there are unjoined crossing lines in between.
Delete unreciprocated links.;
LOOP(I1,1,MAXNOV,1)
IF LACT(IL←(I1+1)%2)
∧(I2←ABS LINK[I1]) THEN
IF ABS LINK[I2]≠I1 THEN LINK[I1]←0 ELSE
IF I2>I1
∧LVERCO[I1]≠LVERCO[I2]
∧(IPK[I1]
∧RK[I1]<(R1←4*RCOL[I1])
∧LVERCO[I1]≠LVERCO[IPK[I1]]
∨IPK[I2]
∧RK[I2]<R1
∧LVERCO[I2]≠LVERCO[IPK[I2]])
THEN BEGIN LINK[I1]←-I2; LINK[I2]←-I1 END;
END "XREF";
_ UNXREF;
_ This procedure disconnects all active lines from each other.
It assumes no inactive lines are connected to c.v.s containing
active lines.;
INTERNAL SIMPLE PROCEDURE UNXREF;
BEGIN "UNXREF"
LOOP(IA,1,MAXNOL,1) IF LACT(IA) THEN
BEGIN
IB←2*IA;
LOOP(IC,0,1,1)
BEGIN
LVER[ID←IB-IC]←ID;
RETCV(LVERCO[ID]);
SVANG[ID]←360.;
END
END;
LOOP(IA,1,MAXNOL,1) IF LACT(IA) THEN
BEGIN
IB←2*IA;
LOOP(IC,0,1,1)
BEGIN
IE ← NEXVER;
ID←IB-IC;
LVERSI[IE]←ID;
LVERCO[ID]←IE;
XVCOR[IE]←XLCOR[ID];
YVCOR[IE]←YLCOR[ID]
END
END;
END "UNXREF";
END "SCENE";